Ejercicio 1.

En cada inciso considera la función de valores reales, usa splines cúbicos para encontrar una aproximación en el intervalo dado. Calcula el valor de la función, de la derivada y en cada caso calcula el error real.

graf<-function(f,x0,x1,x2,x3,x4=NULL,x5=NULL,fder=NULL){
  x_nodes<<-c(x0,x1,x2,x3,x4,x5)
  f_nodes<<-f(x_nodes)
  
  if(!is.null(x5)){
    xMax=x5
  }
  else if(!is.null(x4)){
    xMax=x4
  }
  else{
    xMax=x3
  }
  if(!is.null(fder)){
    x <- x0
    d1=eval(fder)
    x <- xMax
    d2=eval(fder)
    my_spline<<-cubicspline(x_nodes,f_nodes,endp2nd = TRUE,der=c(d1,d2))
    
    x_n<-seq(x0,xMax,length.out=100)
    y_n<-cubicspline(x_nodes,f_nodes,x_n,endp2nd = TRUE,der=c(d1,d2))
  }
  else{
     my_spline<<-cubicspline(x_nodes,f_nodes)
    
    x_n<-seq(x0,xMax,length.out=100)
    y_n<-cubicspline(x_nodes,f_nodes,x_n)
  }
  
  
  graph_spline<-ggplot()+
    geom_function(fun=f,linewidth=1.3,color="dodgerblue")+
    geom_point(aes(x_nodes,f_nodes),color="gold3")+
    geom_line(aes(x_n,y_n),color="red",linewidth=0.75)+
    xlim(x0,xMax)+
    theme_bw()
  
  ggplotly(graph_spline)
}

\(f(x)=e^{2x}\). Puntos: \(x_0=0, x_1=0.25, x_2=0.5, x_3=0.75\). Aproximar \(f(0.43)\) y \(f'(0.43)\).

f <- function(x){exp(2*x)}
f_expr <- expression(exp(2*x))
graf(f,0,.25,.5,.75)

a=0.43
f(a)

## [1] 2.363161

cubicspline(x_nodes,f_nodes,a)

## [1] 2.347353

abs(f(a)-cubicspline(x_nodes,f_nodes,a))

## [1] 0.01580817

# Extraer los coeficientes del segundo polinomio
coefs_2<-my_spline$coefs[2,]
#Coeficientes de la derivada del polinomio anterior
polyder(coefs_2)

## [1] 17.472473  6.332867  3.122624

polyval(polyder(coefs_2),a)

## [1] 9.076417

fder<-D(f_expr,"x")
x <- a
eval(fder)

## [1] 4.726321

\(f(x)=x\, log(x)\), \(x\in [2,12]\), \(h=2\). Aproximar \(f(8.4)\) y \(f'(8.4)\).

f <- function(x){x*log(x)}
f_expr <- expression(x*log(x))
graf(f,2,4,6,8,10,12)

a=8.4
f(a)

## [1] 17.87715

cubicspline(x_nodes,f_nodes,a)

## [1] 17.87406

abs(f(a)-cubicspline(x_nodes,f_nodes,a))

## [1] 0.003082143

# Extraer los coeficientes del segundo polinomio
coefs_2<-my_spline$coefs[2,]
#Coeficientes de la derivada del polinomio anterior
polyder(coefs_2)

## [1] -0.05638427  0.35905631  2.31881241

polyval(polyder(coefs_2),a)

## [1] 1.356411

fder<-D(f_expr,"x")
x <- a
eval(fder)

## [1] 3.128232

\(f(x)=sen(e^x-2)\), \(x\in [0,5]\), \(h=1\). Aproximar \(f(0.9)\) y \(f'(0.9)\).

f <- function(x){sin(exp(x)-2)}
f_expr <- expression(sin(exp(x)-2))
graf(f,0,1,2,3,4,5)

a=0.9
f(a)

## [1] 0.4435924

cubicspline(x_nodes,f_nodes,a)

## [1] 0.656121

abs(f(a)-cubicspline(x_nodes,f_nodes,a))

## [1] 0.2125286

# Extraer los coeficientes del segundo polinomio
coefs_2<-my_spline$coefs[2,]
#Coeficientes de la derivada del polinomio anterior
polyder(coefs_2)

## [1]  4.1692143 -5.1924685 -0.2312599

polyval(polyder(coefs_2),a)

## [1] -1.527418

fder<-D(f_expr,"x")
x <- a
eval(fder)

## [1] 2.204367

\(f(x)=x\, cos\,x-2x^2+3x-1\). \(x\in [0,2]\), \(h=0.5\). Aproximar \(f(0.25)\) y \(f'(0.25)\).

f <- function(x){x*cos(x)-2*x^3+3*x-1}
f_expr <- expression(x*cos(x)-2*x^3+3*x-1)
graf(f,0,.5,1,1.5,2)

a=0.25
f(a)

## [1] -0.03902189

cubicspline(x_nodes,f_nodes,a)

## [1] -0.03225228

abs(f(a)-cubicspline(x_nodes,f_nodes,a))

## [1] 0.006769611

# Extraer los coeficientes del segundo polinomio
coefs_2<-my_spline$coefs[2,]
#Coeficientes de la derivada del polinomio anterior
polyder(coefs_2)

## [1] -4.622062 -7.894533  2.061827

polyval(polyder(coefs_2),a)

## [1] -0.200685

fder<-D(f_expr,"x")
x <- a
eval(fder)

## [1] 3.532061

\(f(x)=x\,cos\,x-3x\). Puntos: \(x_0=0.1, x_1=0.2, x_2=0.3, x_3=0.4\). Aproximar \(f(0.18)\) y \(f'(0.18)\).

f <- function(x){x*cos(x)-3*x}
f_expr <- expression(x*cos(x)-3*x)
graf(f,0.1,.2,.3,.4)

a=0.18
f(a)

## [1] -0.3629081

cubicspline(x_nodes,f_nodes,a)

## [1] -0.3630025

abs(f(a)-cubicspline(x_nodes,f_nodes,a))

## [1] 9.434063e-05

# Extraer los coeficientes del segundo polinomio
coefs_2<-my_spline$coefs[2,]
#Coeficientes de la derivada del polinomio anterior
polyder(coefs_2)

## [1] -2.8389124 -0.5974756 -2.0547869

polyval(polyder(coefs_2),a)

## [1] -2.254313

fder<-D(f_expr,"x")
x <- a
eval(fder)

## [1] -2.048382

Ejercicio 2

Encuentra los splines cúbicos condicionados para las funciones del ejercicio anterior.

\(f(x)=e^{2x}\). Puntos: \(x_0=0, x_1=0.25, x_2=0.5, x_3=0.75\).

# Definir los puntos y la función
f <- function(x){exp(2*x)}
f_expr <- expression(exp(2*x))
fder<-D(f_expr,"x")
graf(f,0,.25,.5,.75,fder=fder)

\(f(x)=x\, log(x)\), \(x\in [2,12]\), \(h=2\).

# Definir los puntos y la función
f <- function(x){x*log(x)}
f_expr <- expression(x*log(x))
fder<-D(f_expr,"x")
graf(f,2,4,6,8,10,12,fder=fder)

\(f(x)=sen(e^x-2)\), \(x\in [0,5]\), \(h=1\).

# Definir los puntos y la función
f <- function(x){sin(exp(x)-2)}
f_expr <- expression(sin(exp(x)-2))
fder<-D(f_expr,"x")
graf(f,0,1,2,3,4,5,fder=fder)

\(f(x)=x\, cos\,x-2x^2+3x-1\). \(x\in [0,2]\), \(h=0.5\).

# Definir los puntos y la función
f <- function(x){x*cos(x)-2*x^2+3*x-1}
f_expr <- expression(x*cos(x)-2*x^2+3*x-1)
fder<-D(f_expr,"x")
graf(f,0,.5,1,1.5,2,fder=fder)

\(f(x)=x\,cos\,x-3x\). Puntos: \(x_0=0.1, x_1=0.2, x_2=0.3, x_3=0.4\).

# Definir los puntos y la función
f <- function(x){x*cos(x)-3*x}
f_expr <- expression(x*cos(x)-3*x)
fder<-D(f_expr,"x")
graf(f,0.1,.2,.3,.4,fder=fder)

Ejercicio 3

Se sospecha que las elevadas concentraciones de tanina en las hojas de los robles maduros inhiben el crecimiento de las larvas de la polilla invernal (Operophtera bromata L. Geometridae) que tanto dañan a los árboles en algunos años. La tabla anexa contiene el peso promedio de dos muestras de larva, tomadas en los primeros 28 días después de nacimiento. La primera muestra se crió en hojas de robles jóvenes, mientras que la segunda lo hizo en hojas maduras del mismo árbol.

Usa splines cúbicos para aproximar la curva del peso promedio de las muestras.
Para calcular un peso promedio máximo aproximado de cada muestra, determina el máximo del polinomio interpolante.

\[\begin{equation} \begin{array}{l|c|c|c|c|c|c|r} \text{Día} & 0 & 6 & 10 & 13 & 17 & 20 & 28 \\ \hline \text{Peso promedio muestra 1 (mg)} & 6.67 & 17.33 & 42.67 & 37.33 & 30.10 & 29.31 & 28.74 \\ \text{Peso promedio muestra 2 (mg)} & 6.67 & 16.11 & 18.89 & 15.00 & 10.56 & 9.44 & 8.89 \end{array} \end{equation}\]

# Datos de muestra
dias <- c(0, 6, 10, 13, 17, 20, 28)
peso_muestra1 <- c(6.67, 17.33, 42.67, 37.33, 30.10, 29.31, 28.74)
peso_muestra2 <- c(6.67, 16.11, 18.89, 15.00, 10.56, 9.44, 8.89)

# Ajustar splines cúbicos
spline_muestra1 <- spline(dias, peso_muestra1)
spline_muestra2 <- spline(dias, peso_muestra2)

# Encontrar el máximo del polinomio interpolante
maximo_muestra1 <- optimize(splinefun(dias,peso_muestra1), interval = c(0,28), maximum = TRUE)
maximo_muestra2 <- optimize(splinefun(dias,peso_muestra2), interval = c(0,28), maximum = TRUE)

# Mostrar resultados
cat("Máximo aproximado de la muestra 1:", maximo_muestra1$maximum,"\n")

## Máximo aproximado de la muestra 1: 10.48862

cat("Máximo aproximado de la muestra 2:", maximo_muestra2$maximum,"\n")

## Máximo aproximado de la muestra 2: 9.289588

# Crear un data frame con los datos de los splines
datos_spline <- data.frame(dias = c(spline_muestra1$x,spline_muestra2$x),
                           peso = c(spline_muestra1$y,spline_muestra2$y),
                           muestra = rep(c("Muestra 1","Muestra 2"),each=length(spline_muestra1$x)))

# Crear el gráfico con ggplot
p <- ggplot(datos_spline,aes(x=dias,y=peso,color=muestra)) +
     geom_line() +
     labs(title="Peso promedio de las muestras (splines cúbicos)",
          x="Día",
          y="Peso promedio (mg)")+
  theme_bw()

# Convertir el gráfico en interactivo con ggplotly
ggplotly(p)

Ejercicio 4

Construye los splines cúbicos con \(n\) nodos, donde \(n=3,4,5\) para las siguientes funciones en el intervalo dado.

cubi <- function(f,f_expr,i,d){
  l<-i
  r<-d
  der<-D(f_expr,"x")
  d<-c()
  x<-i
  d[1]=eval(der)
  x<-d
  d[2]=eval(der)
  resultados <- list()
  
  for (n_nodos in 3:5) {
    x_n <- seq(l, r, length.out = n_nodos)
    f_n <- f(x_n)
    
    cubicspline(x_n, f_n, endp2nd = TRUE, der = c(d[1], d[2]))
    
    x_cs <- seq(l, r, length.out = 100)
    y_cs <- cubicspline(x_n, f_n, x_cs)
    y_cscond <- cubicspline(x_n, f_n, x_cs, endp2nd = TRUE, der = c(d[1], d[2]))
    
    # Guardar los resultados en la lista
    resultados[[paste0("x_", n_nodos)]] <- x_n
    resultados[[paste0("f_", n_nodos)]] <- f_n
    resultados[[paste0("x_cs", n_nodos)]] <- x_cs
    resultados[[paste0("y_cs", n_nodos)]] <- y_cs
    resultados[[paste0("y_cscond", n_nodos)]] <- y_cscond
  }
  graf_f<-ggplot()+
    geom_function(fun=f,color="deeppink3",linewidth=1.1)+
    geom_point(aes(resultados$x_3,resultados$f_3),size=2,color="blue3")+
    geom_line(aes(resultados$x_cs3,resultados$y_cs3),linewidth=.8,linetype="dashed",color="dodgerblue")+
    geom_line(aes(resultados$x_cs3,resultados$y_cscond3),linewidth=.8,linetype="dashed",color="dodgerblue3")+
    geom_point(aes(resultados$x_4,resultados$f_4),size=2,color="red3")+
    geom_line(aes(resultados$x_cs4,resultados$y_cs4),linewidth=.8,linetype="dashed",color="firebrick")+
    geom_line(aes(resultados$x_cs4,resultados$y_cscond4),linewidth=.8,linetype="dashed",color="firebrick3")+
    geom_point(aes(resultados$x_5,resultados$f_5),size=2,color="olivedrab")+
    geom_line(aes(resultados$x_cs5,resultados$y_cs5),linewidth=.8,linetype="dashed",color="green")+
    geom_line(aes(resultados$x_cs5,resultados$y_cscond5),linewidth=.8,linetype="dashed",color="green3")+
    xlim(l,r)+
    theme_minimal()
  ggplotly(graf_f)
}

\(f(x) = e^{2x}\, cos 3x\), \([0,2]\).

f<-function(x){exp(2*x)*cos(3*x)}
f_expr<-expr(exp(2*x)*cos(3*x))
cubi(f,f_expr,0,2)

\(f(x) = sen(log\,x)\), \([1,3]\).

f<-function(x){sin(log(x))}
f_expr<-expr(sin(log(x)))
cubi(f,f_expr,1,3)

\(f(x) = e^{x}+e^{-x}\), \([0,2]\).

f<-function(x){exp(x)+exp(-x)}
f_expr<-expr(exp(x)+exp(-x))
cubi(f,f_expr,0,2)

\(f(x) = cos \,x+sen\,x\), \([0,2\pi]\).

f<-function(x){cos(x)+sin(x)}
f_expr<-expr(cos(x)+sin(x))
cubi(f,f_expr,0,2*pi)

Ejercicio 5

Dada la partición \(x_0=0, x_1=0.5, x_2=1\), del intervalo \([0,1]\), encuentra el spline cúbico \(S\) para \(f(x)=e^{2x}\). Aproxima \(\int_0^{1} e^{2x}\,dx\) con \(\int_0^{1} S(x)\,dx\) y compara el resultado con el valor real.

Tarea 5. Splines cúbicos.

Análisis Numérico. Luis Antonio Domínguez Ávila

Marzo del 2023

Ejercicio 1.

Ejercicio 2

Ejercicio 3

Ejercicio 4

Ejercicio 5